home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / MacMarlais 0.5.9d46 / Examples / Windows.dyl < prev    next >
Encoding:
Text File  |  1995-02-12  |  5.0 KB  |  182 lines  |  [TEXT/Mrls]
  1. module:            dylan-user
  2. author:            Patrick C. Beard <beard@cs.ucdavis.edu>
  3. description:        Implements class <window>.
  4.  
  5. define class <text-style> (<object>)
  6.     slot font-name :: <string>,
  7.         init-value: #f,
  8.         init-keyword: name:;
  9.     slot font-size :: <small-integer>,
  10.         init-value: #f,
  11.         init-keyword: size:;
  12.     slot font-face :: <small-integer>,
  13.         init-value: #f,
  14.         init-keyword: face:;
  15. end class <text-style>;
  16.  
  17. // constants useful for specifying a text face.
  18. define constant $bold = 1;
  19. define constant $italic = 2;
  20. define constant $underline = 4;
  21. define constant $outline = 8;
  22. define constant $shadow = 16;
  23. define constant $condense = 32;
  24. define constant $extend = 64;
  25.  
  26. define class <window> (<object>)
  27.     slot title :: <string>,
  28.         required-init-keyword: title:,
  29.         setter: %title-setter;
  30.     slot bounds :: <vector>,
  31.         required-init-keyword: bounds:,
  32.         setter: %bounds-setter;
  33.     slot visible :: <boolean>,
  34.         init-value: #f,
  35.         init-keyword: visible:,
  36.         setter: %visible-setter;
  37.     slot pen-size :: <vector>,
  38.         init-value: #[1, 1],
  39.         setter: %pen-size-setter;
  40.     slot text-style,
  41.         init-function: method() make(<text-style>) end,
  42.         setter: %text-style-setter;
  43.     slot updater :: <method>,
  44.         init-value: #f,
  45.         init-keyword: updater:;
  46.     slot pointer :: union(<foreign-pointer>, singleton(#f));
  47. end class;
  48.  
  49. // keep track of all windows in a hash table keyed on <foreign-pointer>.
  50. define constant *dylan-windows* = make(<table>);
  51.  
  52. // a union type for methods that return a <window> or #f.
  53. define constant <window-or-false> = union(<window>, singleton(#f));
  54.  
  55. define method initialize (self :: <window>, #key, #all-keys)
  56.     next-method();
  57.     self.pointer := %new-window(self.title, self.bounds, self.visible);
  58.     *dylan-windows*[self.pointer] := self;
  59. end method;
  60.  
  61. define method window-dispose (self :: <window>)
  62.     if (self.pointer)
  63.         *dylan-windows*[self.pointer] := #f;
  64.         %dispose-window(self.pointer);
  65.         self.pointer := #f;
  66.     end if;
  67. end method;
  68.  
  69. define method window-erase (self :: <window>)
  70.     if (self.pointer)
  71.         %erase-window(self.pointer);
  72.     end if;
  73. end method;
  74.  
  75. define method window-draw-line (self :: <window>, line :: <vector>)
  76.     if (self.pointer)
  77.         %draw-line(self.pointer, line);
  78.     end if;
  79. end method;
  80.  
  81. define method window-move-to (self :: <window>, x :: <small-integer>, y :: <small-integer>)
  82.     if (self.pointer)
  83.         %move-to(self.pointer, x, y);
  84.     end if;
  85. end method;
  86.  
  87. define method window-draw-string (self :: <window>, str :: <string>)
  88.     if (self.pointer)
  89.         %draw-string(self.pointer, str);
  90.     end if;
  91. end method;
  92.  
  93. define method front-window() => result :: <window-or-false>;
  94.     let front-pointer = %front-window();
  95.     if (front-pointer)
  96.         *dylan-windows*[front-pointer];
  97.     else
  98.         #f;
  99.     end if;
  100. end method;
  101.  
  102. define method next-window(self :: <window>) => result :: <window-or-false>;
  103.     let next-pointer = %next-window(self.pointer);
  104.     if (next-pointer)
  105.         *dylan-windows*[next-pointer];
  106.     else
  107.         #f;
  108.     end if;
  109. end method;
  110.  
  111. // setter of title slot, performs the low level retitle.
  112. define method title-setter(new-title :: <string>, self :: <window>)
  113.     if (self.pointer)
  114.         %title-setter(new-title, self);
  115.         %set-window-title(self.pointer, new-title);
  116.     end if;
  117. end method;
  118.  
  119. // setter of bounds slot, performs the low level resize.
  120. define method bounds-setter(new-bounds :: <vector>, self :: <window>)
  121.     if (self.pointer & new-bounds.size = 4)
  122.         %bounds-setter(new-bounds, self);    // actually sets the slot.
  123.         %set-window-bounds(self.pointer, new-bounds);
  124.     end if;
  125. end method;
  126.  
  127. // setter of visible slot, performs visibility setting.
  128. define method visible-setter(vis :: <boolean>, self :: <window>)
  129.     if (self.pointer & self.visible ~= vis)
  130.         %visible-setter(vis, self);    // actually sets the slot.
  131.         if (vis)
  132.             %show-window(self.pointer);
  133.         else
  134.             %hide-window(self.pointer);
  135.         end if;
  136.     end if;
  137. end method;
  138.  
  139. // setter of pen-size slot, performs pen-size setting.
  140. define method pen-size-setter(new-pen-size :: <vector>, self :: <window>)
  141.     if (self.pointer)
  142.         %pen-size-setter(new-pen-size, self);    // actually sets the slot.
  143.         %set-pen-size(self.pointer, new-pen-size[0], new-pen-size[1]);
  144.     end if;
  145. end method;
  146.  
  147. // setter of text-style slot, performs pen-size setting.
  148. define method text-style-setter(new-text-style :: <text-style>, self :: <window>)
  149.     if (self.pointer)
  150.         %text-style-setter(new-text-style, self);
  151.         %set-text-style(self.pointer, new-text-style);
  152.     end if;
  153. end method;
  154.  
  155. // private methods for handling window updates.
  156.  
  157. define method dispatch-window-update (pointer :: <foreign-pointer>)
  158.     let window = *dylan-windows*[pointer];
  159.     if (window)
  160.         // refresh the bounds.
  161.         %bounds-setter(%get-window-bounds(pointer), window);
  162.         if (window.updater)
  163.             window.updater(window);
  164.         end if;
  165.     end if;
  166. end method;
  167.  
  168. /*
  169.     define variable *window* = make(<window>, title: "Graphics", bounds: #[50, 10, 250, 310]);
  170.     *window*.visible := #t;
  171.     *window*.visible := #f;
  172.     *window*.updater := method(window :: <window>)
  173.         window-erase(window);
  174.         window-draw-line(window, #[0, 0, 200, 300]);
  175.         window-draw-line(window, #[200, 0, 0, 300]);
  176.         window-draw-line(window, #[100, 0, 100, 300]);
  177.         window-draw-line(window, #[0, 150, 200, 150]);
  178.     end method;
  179.     *window*.visible := #t;
  180.     window-dispose(*window*);
  181. */
  182.